#!/usr/bin/perl -w

BEGIN {
	use Cwd;
	my $x=cwd;
	push @::INC,"$x/libs";
}

use XML::Parser;
use Data::Dumper;
use File::Basename;
use POSIX qw(setsid);
use Sys::Hostname;
use gri_frontend;
use gri_userprefs;
use gri_secmgr qw(get_cookie_value got_cookie redirect_header
	set_cookie send_cookie);

umask 007;
#########################################################################
# The configuration uses the SCRIPT_FILENAME as a directory to find	#
# the gri_macro_handler.xml file, defaulting to . if not set.		#
#########################################################################

BEGIN {
	if(!exists($::ENV{SCRIPT_FILENAME})) {
		$CFG_FILE="./gri_macro_handler.xml";
		$PM2_PATH=".";
	} else {
		$CFG_FILE=dirname($::ENV{SCRIPT_FILENAME})."/gri_macro_handler.xml";
		$PM2_PATH=dirname($::ENV{SCRIPT_FILENAME});
	}
	if(-f "$CFG_FILE.".hostname) {
		$CFG_FILE.=".".hostname;
	}

#########################################################################
# If the configuration file can not be found then abort!		#
#########################################################################

	if(! -f $CFG_FILE) {
		print "Content-Type: text/html\n\n";
		print "<P>Error: File $CFG_FILE can not be found!</P>\n"; exit 0;
	}
}

eval "use gri_macro_handler qw(
	get_posted_vars
	lindex
	get_xml_attribute
	to_bool
	html_error
	load_gri_macro_config
	load_macro
	shtml_page
	pcodes_to_html
	get_client_sock
	hex_to_string
	get_authenticated_user
	string_to_hex
	_encode_base64
	_decode_base64
);";

if($@) {
	print "Content-Type: text/html\n\n";
	print "<P>Error: Error whilst loading gri_macro_handler.pm:<br>$@</P>\n"; exit 0;
}
get_posted_vars();
($::CONFIG,$err)=load_gri_macro_config($CFG_FILE);
if(!defined($::CONFIG)) {
	html_error("Error parsing configuration:\n$err");
}

$::GRI_FRONTEND=new gri_frontend($::ENV{GRI_CONFIG});
if(!defined($::GRI_FRONTEND)) {
	my $e=gri_frontend::error();
	print "<P>Error: $e</P>\n";
	exit 0;
}

#########################################################################
# Even before we do anything else we add an audit log entry.		#
#########################################################################

{
	my $user;
	$user=get_authenticated_user();
	print STDERR "auth_user=$user\n" if defined($user);
	if(!defined($user) || !length($user)) {
		if(!got_cookie(name => "gri_dbm_intranet")) {
			$user="Not logged in";
		} else {
			my $gv=get_cookie_value(name => "gri_dbm_intranet");
			$user=$gv;
			$user =~ s/\s+.*//;
		}
	} else {
		my $gv=get_cookie_value(name => "gri_dbm_intranet");
		if(!defined($gv) || !length($gv)) {
			my $cookie=set_cookie(name => "gri_dbm_intranet",
				value => "$user dummy");
			send_cookie(cookie => $cookie);
		}
	}
	my $page=$::ENV{REQUEST_URI};
	$page =~ s!^/gri/index.cgi[/]{0,1}!!;
	$page =~ s!^/gri[/]{0,1}!!;
	$page =~ s!\?.*!!;
	$page =~ s/!$//;
	my $args=$::ENV{QUERY_STRING};
	$args="" if !defined($args);
	$::GRI_FRONTEND->std_audit_log_write($user,$page,$args);
}

#########################################################################
# For security we need to cleanse the REQUEST_URI and QUERY_STRING	#
# of the following characters so attempts at code injection are		#
# aborted.								#
#########################################################################

{
	my $x=$::ENV{REQUEST_URI};
	$x =~ s/\`//g;
	$x =~ s/\|//g;
	# $x =~ s/\&//g;
	$x =~ s/\$//g;
	$x =~ s/\<//g;
	$x =~ s/\>//g;
	$::ENV{REQUEST_URI}=$x;
	$x=$::ENV{QUERY_STRING};
	$x =~ s/\`//g;
	$x =~ s/\|//g;
	# $x =~ s/\&//g;
	$x =~ s/\$//g;
	$x =~ s/\<//g;
	$x =~ s/\>//g;
	$::ENV{QUERY_STRING}=$x;
}

if($::ENV{REQUEST_URI} =~ /login/) { 
	my $user;
	if(!got_cookie(name => "gri_dbm_intranet")) {
		$user="Not logged in";
	} else {
		my $gv=get_cookie_value(name => "gri_dbm_intranet");
		$user=$gv;
		$user =~ s/\s+.*//;
		if(defined($user) && length($user)) {
			my $urlprefix=$::GRI_FRONTEND->get_url_prefix();
			$link="$urlprefix$::ENV{SCRIPT_NAME}";
			redirect_header(path => $link);
		}
	}
}

if($::ENV{REQUEST_URI} =~ /show_error/) { 
	shtml_page($::CONFIG);
	exit(0);
}
if($::ENV{REQUEST_URI} =~ /validate_pw/) {
	# Here we validate the cookie, install it, and
	# redirect to a real page.

	my %params=();
	my @args=split(/,/,$::ENV{QUERY_STRING});
	for my $cc (@args) {
		if($cc =~ /=/) {
			my ($parm,$val)=($cc =~ /(.*)=(.*)/);
			$val="" if !defined($val);
			$params{$parm}=$val;
		}
	}

	#################################################################
	# Check the password before we go further...			#
	#################################################################
	my $urlprefix=$::GRI_FRONTEND->get_url_prefix();
	my ($a,$b)=$::GRI_FRONTEND->send_authd_request("IS_VALID  U=$::PARAM{username} P=$::PARAM{password}\n");
	if(!$a) {
		my $error="Error whilst attempting to communicate to authenticate process.";
		my $error2=join("\n",@$b);
		$link="$urlprefix$::ENV{SCRIPT_NAME}/show_error?error=" . string_to_hex($error) . ",error2=" . string_to_hex($error2);
		redirect_header(path => $link);
		exit(0);
	}
	my $res=$b; chomp $res;
	if($res eq "OK") {
		my $cookie=set_cookie(name => "gri_dbm_intranet",
					value => "$::PARAM{username} $::PARAM{password}");
		send_cookie(cookie => $cookie);
		my $link="$urlprefix$::ENV{SCRIPT_NAME}";
		if(exists($params{lp}) && $params{lp}) {
			$link="$urlprefix".hex_to_string($params{lp});
		}
		redirect_header(path => $link);
		exit(0);
	}

	#################################################################
	# If we get here we show the error page and allow the users to	#
	# attempt to enter the details again...				#
	#################################################################

	my $args="";
	my @A=();
	push @A,"lp=$params{lp}" if (exists($params{lp}) && $params{lp});
	push @A,"error=".string_to_hex($res);
	
	my $link="$urlprefix$::ENV{SCRIPT_NAME}" . "/show_login_error?" . join(",",@A);
	redirect_header(path => $link);
	exit(0);
}

#########################################################################
# Check to see if the cookie is set and if not we redirect to that	#
# page first 								#
#########################################################################
$gv="";
$gv=get_cookie_value(name => "gri_dbm_intranet");
if(!got_cookie(name => "gri_dbm_intranet") && $::ENV{REQUEST_URI} !~ /login/) { 
	# Recurse to get login details...
	my %params=();
	my @args=split(/,/,$::ENV{QUERY_STRING});
	for my $cc (@args) {
		if($cc =~ /=/) {
			my ($parm,$val)=($cc =~ /(.*)=(.*)/);
			$val="" if !defined($val);
			$params{$parm}=$val;
		}
	}
	my $lp;
	if(!exists($params{lp})) {
		if(exists($::ENV{REQUEST_URI})) {
			if($::ENV{REQUEST_URI} =~ /\/login/) {
				$lp="";
			} else {
				my $x=$::ENV{REQUEST_URI};
				if($x) {
					$lp="?lp=".string_to_hex($x);
				} else {
					$lp="";
				}
			}
		}
	} else {
		$lp="?lp=$lp";
	}
	my $urlprefix=$::GRI_FRONTEND->get_url_prefix();
	print STDERR "urlprefix=$urlprefix\n";
	redirect_header(path => "$urlprefix$::ENV{SCRIPT_NAME}/login$lp");
	exit(0);
}

#########################################################################
# If we have a portal= in the URL then we validate that the password	#
# we have is suitable, otherwise we reject the request...		#
#########################################################################

#########################################################################
# If the Modperl extension is supported by the site jump to that	#
# version if possible.							#
#########################################################################

if(lc($::CONFIG->{site}->{mpl}->{supported}) eq "yes") {
	print "Content-Type: text/html\n\n";
	print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=index.mpl\">\n";
	exit 0;
}

#########################################################################
# Set all environment variables before doing anything else		#
#########################################################################

if(exists($::CONFIG->{env})) {
	foreach $cvar (keys(%{$::CONFIG->{env}})) {
		$v=$::CONFIG->{env}->{$cvar};
		if(substr($v,0,1) eq "+") {
			$::ENV{$cvar}="" if !exists($::ENV{$cvar});
			$::ENV{$cvar}.=substr($v,1);
		} else {
			$::ENV{$cvar}=$v;
		}
	}
}

shtml_page($::CONFIG);
exit 0;
